# Tray icon support.
# See also plugins/unix/systray.tcl, plugins/unix/dokingtray.tcl,
#          plugins/windows/taskbar.tcl.

##########################################################################

namespace eval systray {
    variable saved_state normal
    variable saved_geometry 
    variable balloon ""

    variable s2p
    array set s2p {}
  
    variable icons {}

    variable options

    custom::defgroup Systray [::msgcat::mc "Systray icon options."] \
	-group IFace

    custom::defvar options(display_status) 0 \
	[::msgcat::mc "Display status tooltip when main window is minimized\
		       to systray."] \
	-group Systray -type boolean

    custom::defvar options(blink) 0 \
	[::msgcat::mc "Systray icon blinks when there are unread messages."] \
	-group Systray -type boolean
}

##########################################################################

proc systray::token {icon} {
    return [namespace current]::$icon
}

##########################################################################

proc systray::create {icon args} {
    global curuserstatus
    variable icons

    set token [token $icon]
    if {[info exists $token]} {
	return -code error "Systray icon $icon exists"
    }
    lappend icons $icon
    upvar 0 $token state

    array set state {create "" configure "" destroy "" tray ""}

    foreach {key val} $args {
	switch -- $key {
	    -createcommand { set state(create) $val }
	    -configurecommand { set state(configure) $val }
	    -destroycommand { set state(destroy) $val }
	    -locationcommand { set state(location) $val }
	}
    }

    $state(create) $icon
    update $icon ::curuserstatus
    update $icon ::tabcolors

    foreach var [list curuserstatus tabcolors] {
        trace variable ::$var w [list [namespace code update] $icon]
    }
}

##########################################################################

proc systray::destroy {icon} {
    variable icons

    catch {
	upvar 0 [token $icon] state

	$state(destroy) $icon
	unset state

	set id [lsearch -exact $icons $icon]
	if {$id >= 0} {
	    set icons [lreplace $icons $id $id]
	}
    }

    foreach var [list curuserstatus tabcolors] {
        trace vdelete ::$var w [list [namespace code update] $icon]
    }
}

##########################################################################

proc systray::popupmenu {m} {
    set tearoff [set [namespace parent]::options(show_tearoffs)]

    menu $m -title [::msgcat::mc "Tkabbur Systray"] -tearoff $tearoff
    $m add command -label [::msgcat::mc "About"] \
	-command [list [namespace parent]::about_window]
    $m add separator
    
    menu $m.presence -title [::msgcat::mc "Presence"] -tearoff $tearoff
    set pm [.mainframe getmenu presence]
    set id [$pm index [::msgcat::mc "Available"]]
    for {set i 0} {$i < 7} {incr i} {
	if {[catch { $pm entryconfigure $id -label }]} {
	    $m.presence add separator
	} else {
	    $m.presence add command \
		-label [lindex [$pm entryconfigure $id -label] 4] \
		-command  [lindex [$pm entryconfigure $id -command] 4]
	}
	incr id
    }

    $m add cascade -label [::msgcat::mc "Presence"] -menu $m.presence
    set tm [.mainframe getmenu tkabbur]
    set id [$tm index [::msgcat::mc "Log in..."]]
    for {set i 0} {$i < 2} {incr i} {
        $m add command -label [lindex [$tm entryconfigure $id -label] 4] \
		       -command  [lindex [$tm entryconfigure $id -command] 4]
	incr id
    }
    $m add separator
    $m add command -label [::msgcat::mc "Show main window"] \
		   -command [namespace code restore]
    $m add command -label [::msgcat::mc "Hide main window"] \
		   -command [namespace code withdraw]
    $m add separator
    $m add command -label [::msgcat::mc "Quit"] -command quit

    return $m
}

##########################################################################

# Withdraws the main Tkabber window from the screen:
proc systray::withdraw {} {
    variable saved_state
    variable saved_geometry

    if {[cequal [wm state .] withdrawn]} return

    set saved_state [wm state .]
    set saved_geometry [wm geometry .]
    wm withdraw .
}

# Iconifies the main Tkabber window:
proc systray::iconify {} {
    if {[cequal [wm state .] iconic]} return

    wm iconify .
}

# De-withdraws the main Tkabber window:
proc systray::reshow {} {
    variable saved_state
    variable saved_geometry

    if {![cequal [wm state .] withdrawn]} return

    if {[info exists saved_state]} {
	if {$saved_state != "zoomed" && [info exists saved_geometry]} {
	    wm geometry . $saved_geometry
	}
	wm state . $saved_state
    } else {
	if {[info exists saved_geometry]} {
	    wm geometry . $saved_geometry
	}
	wm state . normal
    }
    wm deiconify .
}

# Restores the main Tkabber window from iconic or withdrawn states:
proc systray::restore {} {
    switch -- [wm state .] {
	iconic {
	    wm deiconify .
	}
	withdrawn {
	    reshow
	}
	default {
	    wm deiconify .
	}
    }
    raise .
}

proc systray::toggle_state {} {
    switch -- [wm state .] {
	zoomed -
        normal {
	    withdraw
        }

	iconic -
	withdrawn -
	default {
	    restore
	}
    }
}

##########################################################################

proc systray::wm_win_iconify {action} {
    variable icons

    if {$action == "systray"} {
	if {![lempty $icons]} {
	    toggle_state
	}
	return stop
    }
}

hook::add protocol_wm_delete_window_hook \
    [namespace current]::systray::wm_win_iconify 40

##########################################################################

proc systray::quit {} {
    variable icons

    foreach icon $icons {
	destroy $icon
    }
}

hook::add quit_hook [namespace current]::systray::quit

##########################################################################

proc systray::update {icon name1 {name2 ""} {op ""}} {
    global curuserstatus
    upvar 0 [token $icon] state

    if {![info exists state(tray)]} return

    switch -- [string trimleft $name1 :] {
	curuserstatus {
	    if {$state(tray) == ""} {
		$state(configure) $icon $curuserstatus
	    }
	}

	tabcolors {
	    toggle $icon 1
	}
    }
}

##########################################################################

proc systray::toggle {icon ff} {
    global curuserstatus tabcolors
    variable options
    upvar 0 [token $icon] state

    if {![info exists state(tray)]} return
    if {![winfo exists $icon]} return

    if {![cequal $state(tray) ""]} {
	after cancel $state(tray)
	set state(tray) ""
    }

    set hitP 0
    foreach {k v} [array get tabcolors] {
	if {[.nb index $k] < 0} {
	    continue
	}
	if {(![cequal $v ""]) && ($v > $hitP)} {
	    set hitP $v
	}
    }

    if {$hitP == 0} {
	update $icon ::curuserstatus
	return
    }

    if {$options(blink)} {
	set state(tray) \
	    [after 500 [list [namespace current]::toggle $icon [expr {!$ff}]]]
	if {$ff} {
	    $state(configure) $icon message$hitP
	} else {
	    $state(configure) $icon blank
	}
    } else {
	set state(tray) message
	$state(configure) $icon message$hitP
    }
}

##########################################################################

proc systray::set_status {text} {
    variable options
    variable icons
    variable balloon

    if {!$options(display_status)} return
    if {[lempty $icons]} return

    set icon [lindex $icons 0]
    upvar 0 [token $icon] state

    switch -- [wm state .] {
        normal { }
        default {
	    if {[info exists balloon] && ($balloon != "")} {
		after cancel $balloon
		set balloon ""
            }
	    
	    if {![winfo exists $icon]} {
		return
	    }
	    balloon::set_text $text
	    if {[info exists state(location)]} {
		lassign [$state(location) $icon] x y
	    } else {
		set x [winfo rootx $icon]
		set y [winfo rooty $icon]
	    }
	    balloon::show $x $y
	    set balloon [after 15000 balloon::destroy]
        }
    }
}

hook::add set_status_hook [namespace current]::systray::set_status

##########################################################################

proc systray::clear_status {} {
    variable options
    variable icons
    variable balloon

    if {!$options(display_status)} return
    if {[lempty $icons]} return

    if {[info exists balloon] && ($balloon != "")} {
        after cancel $balloon
	set balloon ""
    }
    balloon::destroy
}

hook::add clear_status_hook [namespace current]::systray::clear_status

##########################################################################

proc systray::balloon {icon} {
    return [list $icon [balloon_text]]
}

##########################################################################

proc systray::balloon_text {} {
    global userstatusdesc textstatus

    if {![string equal $textstatus ""]} {
        set status $textstatus
    } else {
        set status $userstatusdesc
    }

    return "Tkabbur: $status"
}

##########################################################################

# vim:ts=8:sw=4:sts=4:noet
